home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / xlisp2.arc / XLISP.H < prev    next >
Encoding:
C/C++ Source or Header  |  1986-05-22  |  6.9 KB  |  270 lines
  1. /* xlisp - a small subset of lisp */
  2.  
  3. /* system specific definitions */
  4. /*#define CI*/
  5.  
  6. #ifdef AZTEC
  7. #include "stdio.h"
  8. #include "setjmp.h"
  9. #include "ctype.h"
  10. #else
  11. #include <stdio.h>
  12. #include <setjmp.h>
  13. #include <ctype.h>
  14. #endif
  15.  
  16. /* NNODES    number of nodes to allocate in each request */
  17. /* TDEPTH    trace stack depth */
  18. /* FORWARD    type of a forward declaration (usually "") */
  19. /* LOCAL    type of a local function (usually "static") */
  20.  
  21. /* for the Computer Innovations compiler */
  22. #ifdef CI
  23. #define NNODES        1000
  24. #define TDEPTH        500
  25. #endif
  26.  
  27. /* for the CPM68K compiler */
  28. #ifdef CPM68K
  29. #define NNODES        1000
  30. #define TDEPTH        500
  31. #define LOCAL
  32. #undef NULL
  33. #define NULL        (char *)0
  34. #endif
  35.  
  36. /* for the DeSmet compiler */
  37. #ifdef DESMET
  38. #define NNODES        1000
  39. #define TDEPTH        500
  40. #define LOCAL
  41. #define getc(fp)    getcx(fp)
  42. #define putc(ch,fp)    putcx(ch,fp)
  43. #define EOF        -1
  44. #endif
  45.  
  46. /* for the VAX-11 C compiler */
  47. #ifdef vms
  48. #define NNODES        2000
  49. #define TDEPTH        1000
  50. #endif
  51.  
  52. /* for the DECUS C compiler */
  53. #ifdef decus
  54. #define NNODES        200
  55. #define TDEPTH        100
  56. #define FORWARD        extern
  57. #endif
  58.  
  59. /* for unix compilers */
  60. #ifdef unix
  61. #define NNODES        200
  62. #define TDEPTH        100
  63. #endif
  64.  
  65. /* for the AZTEC C compiler */
  66. #ifdef AZTEC
  67. #define NNODES        200
  68. #define TDEPTH        100
  69. #define getc(fp)    agetc(fp)
  70. #define putc(ch,fp)    aputc(ch,fp)
  71. /*#define malloc        alloc*/
  72. #endif
  73.  
  74. /* default important definitions */
  75. #ifndef NNODES
  76. #define NNODES    200
  77. #endif
  78. #ifndef TDEPTH
  79. #define TDEPTH    100
  80. #endif
  81. #ifndef FORWARD
  82. #define FORWARD
  83. #endif
  84. #ifndef LOCAL
  85. #define LOCAL    static
  86. #endif
  87.  
  88. /* useful definitions */
  89. #define TRUE    1
  90. #define FALSE    0
  91.  
  92. /* program limits */
  93. #define STRMAX        100        /* maximum length of a string constant */
  94.     
  95. /* node types */
  96. #define FREE    0
  97. #define SUBR    1
  98. #define FSUBR    2
  99. #define LIST    3
  100. #define SYM    4
  101. #define INT    5
  102. #define STR    6
  103. #define OBJ    7
  104. #define FPTR    8
  105.  
  106. /* node flags */
  107. #define MARK    1
  108. #define LEFT    2
  109.  
  110. /* string types */
  111. #define DYNAMIC    0
  112. #define STATIC    1
  113.  
  114. /* new node access macros */
  115. #define ntype(x)    ((x)->n_type)
  116. #define atom(x)        ((x) == NULL || (x)->n_type != LIST)
  117. #define null(x)        ((x) == NULL)
  118. #define listp(x)    ((x) == NULL || (x)->n_type == LIST)
  119. #define consp(x)    ((x) && (x)->n_type == LIST)
  120. #define subrp(x)    ((x) && (x)->n_type == SUBR)
  121. #define fsubrp(x)    ((x) && (x)->n_type == FSUBR)
  122. #define stringp(x)    ((x) && (x)->n_type == STR)
  123. #define symbolp(x)    ((x) && (x)->n_type == SYM)
  124. #define filep(x)    ((x) && (x)->n_type == FPTR)
  125. #define objectp(x)    ((x) && (x)->n_type == OBJ)
  126. #define fixp(x)        ((x) && (x)->n_type == INT)
  127. #define car(x)        ((x)->n_car)
  128. #define cdr(x)        ((x)->n_cdr)
  129. #define rplaca(x,y)    ((x)->n_car = (y))
  130. #define rplacd(x,y)    ((x)->n_cdr = (y))
  131.  
  132. /* symbol structure */
  133. struct xsym {
  134.     struct node *xsy_plist;    /* symbol plist - points to (name.plist) */
  135.     struct node *xsy_value;    /* the current value */
  136. };
  137.  
  138. /* subr/fsubr node structure */
  139. struct xsubr {
  140.     struct node *(*xsu_subr)();    /* pointer to an internal routine */
  141. };
  142.  
  143. /* list node structure */
  144. struct xlist {
  145.     struct node *xl_car;    /* the car pointer */
  146.     struct node *xl_cdr;    /* the cdr pointer */
  147. };
  148.  
  149. /* integer node structure */
  150. struct xint {
  151.     int xi_int;            /* integer value */
  152. };
  153.  
  154. /* string node structure */
  155. struct xstr {
  156.     int xst_type;        /* string type */
  157.     char *xst_str;        /* string pointer */
  158. };
  159.  
  160. /* object node structure */
  161. struct xobj {
  162.     struct node *xo_obclass;    /* class of object */
  163.     struct node *xo_obdata;    /* instance data */
  164. };
  165.  
  166. /* file pointer node structure */
  167. struct xfptr {
  168.     FILE *xf_fp;        /* the file pointer */
  169.     int xf_savech;        /* lookahead character for input files */
  170. };
  171.  
  172.  
  173. /* shorthand macros for accessing node substructures */
  174.  
  175. /* symbol node */
  176. #define n_symplist    n_info.n_xsym.xsy_plist
  177. #define n_symvalue    n_info.n_xsym.xsy_value
  178.  
  179. /* subr/fsubr node */
  180. #define n_subr        n_info.n_xsubr.xsu_subr
  181.  
  182. /* list node */
  183. #define n_car        n_info.n_xlist.xl_car
  184. #define n_cdr        n_info.n_xlist.xl_cdr
  185. #define n_ptr        n_info.n_xlist.xl_car
  186.  
  187. /* integer node */
  188. #define n_int        n_info.n_xint.xi_int
  189.  
  190. /* string node */
  191. #define n_str        n_info.n_xstr.xst_str
  192. #define n_strtype    n_info.n_xstr.xst_type
  193.  
  194. /* object node */
  195. #define n_obclass    n_info.n_xobj.xo_obclass
  196. #define n_obdata    n_info.n_xobj.xo_obdata
  197.  
  198. /* file pointer node */
  199. #define n_fp        n_info.n_xfptr.xf_fp
  200. #define n_savech    n_info.n_xfptr.xf_savech
  201.  
  202. /* node structure */
  203. typedef struct node {
  204.     char n_type;        /* type of node */
  205.     char n_flags;        /* flag bits */
  206.     union {            /* value */
  207.     struct xsym n_xsym;    /*     symbol node */
  208.     struct xsubr n_xsubr;    /*     subr/fsubr node */
  209.     struct xlist n_xlist;    /*     list node */
  210.     struct xint n_xint;    /*     integer node */
  211.     struct xstr n_xstr;    /*     string node */
  212.     struct xobj n_xobj;    /*     object node */
  213.     struct xfptr n_xfptr;    /*     file pointer node */
  214.     } n_info;
  215. } NODE;
  216.  
  217. /* execution context flags */
  218. #define CF_GO        1
  219. #define CF_RETURN    2
  220. #define CF_THROW    4
  221. #define CF_ERROR    8
  222.  
  223. /* execution context */
  224. typedef struct context {
  225.     int c_flags;            /* context type flags */
  226.     struct node *c_expr;        /* expression (type dependant) */
  227.     jmp_buf c_jmpbuf;            /* longjmp context */
  228.     struct context *c_xlcontext;    /* old value of xlcontext */
  229.     struct node *c_xlstack;        /* old value of xlstack */
  230.     struct node *c_xlenv,*c_xlnewenv;    /* old values of xlenv and xlnewenv */
  231.     int c_xltrace;            /* old value of xltrace */
  232. } CONTEXT;
  233.  
  234. /* function table entry structure */
  235. struct fdef {
  236.     char *f_name;
  237.     int f_type;
  238.     struct node *(*f_fcn)();
  239. };
  240.  
  241. /* memory segment structure definition */
  242. struct segment {
  243.     int sg_size;
  244.     struct segment *sg_next;
  245.     struct node sg_nodes[1];
  246. };
  247.  
  248. /* external procedure declarations */
  249. extern struct node *xleval();        /* evaluate an expression */
  250. extern struct node *xlapply();        /* apply a function to arguments */
  251. extern struct node *xlevlist();        /* evaluate a list of arguments */
  252. extern struct node *xlarg();        /* fetch an argument */
  253. extern struct node *xlevarg();        /* fetch and evaluate an argument */
  254. extern struct node *xlmatch();        /* fetch an typed argument */
  255. extern struct node *xlevmatch();    /* fetch and evaluate a typed arg */
  256. extern struct node *xlsend();        /* send a message to an object */
  257. extern struct node *xlenter();        /* enter a symbol */
  258. extern struct node *xlsenter();        /* enter a symbol with a static pname */
  259. extern struct node *xlintern();        /* intern a symbol */
  260. extern struct node *xlmakesym();    /* make an uninterned symbol */
  261. extern struct node *xlsave();        /* generate a stack frame */
  262. extern struct node *xlobsym();        /* find an object's class or instance
  263.                        variable */
  264. extern struct node *xlgetprop();    /* get the value of a property */
  265. extern char *xlsymname();        /* get the print name of a symbol */
  266.  
  267. extern struct node *newnode();        /* allocate a new node */
  268. extern char *stralloc();        /* allocate string space */
  269. extern char *strsave();            /* make a safe copy of a string */
  270.